home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / frac.src < prev    next >
Text File  |  1990-10-09  |  10KB  |  452 lines

  1. %%HP: T(3)A(D)F(.);
  2. @ by Dave Vomocil
  3. \<< 
  4.  
  5. @ Each mixed number is a list of size three.
  6. 3 \->LIST 4 ROLLD 3 \->LIST SWAP
  7.  
  8. @ Check that both denom's are non-zero.
  9. DUP2 3 GET SWAP 3 GET AND IF NOT 
  10. THEN
  11.    440 .5 BEEP
  12.    "PLUS: zero in denom" 1 DISP 1 FREEZE
  13. ELSE
  14.  
  15.     64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT
  16.  
  17.     @ Display the first addend
  18.     SWAP 0 DISPL SWAP 
  19.  
  20.     @ Now figure out where to place the + sign
  21.     1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
  22.     20 R\->B 2 \->LIST PICT SWAP
  23.     " + " 3 \->GROB                         @ GOR the + sign into PICT
  24.     GOR
  25.  
  26.     @ And now the second addend
  27.     15 DISPL
  28.     25 R\->B 30 R\->B 2 \->LIST
  29.     85 R\->B 30 R\->B 2 \->LIST LINE
  30.  
  31.     @ ADD the two mixed numbers and DISPL the sum.
  32.  
  33.     @ Compute LCM of denominators
  34.     DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer carry
  35.     \<<
  36.  
  37.     @ Compute numerator of fraction 1
  38.     2 GETI 3 ROLLD GETI SWAP DROP 
  39.     lcm SWAP / 3 ROLL * 'numer' STO
  40.  
  41.     @ Compute numerator of fraction 2 and add
  42.     SWAP 2 GETI 3 ROLLD GETI SWAP DROP 
  43.     lcm SWAP / 3 ROLL * numer + 'numer' STO
  44.  
  45.     @ Check for carry and reduce fraction part
  46.     numer lcm / IP 'carry' STO
  47.     numer lcm MOD 'numer' STO
  48.     numer lcm GCD  DUP
  49.  
  50.     @ Reduce if non-zero GCD
  51.     DUP IF THEN
  52.          numer SWAP / 'numer' STO
  53.          lcm SWAP / 'lcm' STO
  54.        ELSE
  55.          DROP2
  56.        END
  57.  
  58.     @ Add the whole numbers and the carry
  59.     1 GET SWAP 1 GET + carry +
  60.  
  61.     @ Form the mixed number list
  62.     numer lcm 3 \->LIST
  63.  
  64.     \>> @ end of scope of lcm numer and carry
  65.  
  66.     @ DISPL the result
  67.     32 DISPL
  68.  
  69. @ Convert the list to elements on the stack.
  70. OBJ\-> DROP
  71.  
  72. END
  73. \>> 'PLUS' STO
  74.  
  75.  
  76. \<< 
  77.  
  78. @ Convert elements on the stack to two lists
  79. 3 \->LIST 4 ROLLD 3 \->LIST SWAP
  80.  
  81. @ Check that both denom's are non-zero.
  82. DUP2 3 GET SWAP 3 GET AND IF NOT 
  83. THEN
  84.    440 .5 BEEP
  85.    "SUBTR: zero in denom" 1 DISP 1 FREEZE
  86. ELSE
  87.  
  88.     64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT
  89.  
  90.     @ Display the first minuend
  91.     SWAP 0 DISPL SWAP 
  92.  
  93.     @ Now figure out where to place the - sign
  94.     1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
  95.     20 R\->B 2 \->LIST PICT SWAP
  96.     " - " 3 \->GROB                         @ GOR the + sign into PICT
  97.     GOR
  98.  
  99.     @ And now the second subtrahend
  100.     15 DISPL
  101.     25 R\->B 30 R\->B 2 \->LIST
  102.     85 R\->B 30 R\->B 2 \->LIST LINE
  103.  
  104.     @ ADD the two mixed numbers and DISPL the sum.
  105.  
  106.     @ Compute LCM of denominators
  107.     DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer borrow
  108.     \<<
  109.  
  110.     @ Compute numerator of fraction 1
  111.     2 GETI 3 ROLLD GETI SWAP DROP 
  112.     lcm SWAP / 3 ROLL * 'numer' STO
  113.  
  114.     @ Compute numerator of fraction 2 
  115.     SWAP 2 GETI 3 ROLLD GETI SWAP DROP 
  116.     lcm SWAP / 3 ROLL *  numer SWAP - DUP
  117.  
  118.     @ Determine if we need to borrow
  119.     WHILE 0 < 
  120.        REPEAT lcm + DUP 'borrow' 1 STO+ END
  121.     'numer' STO
  122.  
  123.     @ Reduce fraction part
  124.     numer lcm GCD  DUP
  125.    
  126.     @ Reduce if non-zero GCD
  127.     DUP IF THEN
  128.          numer SWAP / 'numer' STO
  129.          lcm SWAP / 'lcm' STO
  130.        ELSE
  131.          DROP2
  132.        END
  133.  
  134.     @ Subtract the whole numbers 
  135.     SWAP 1 GET SWAP 1 GET - borrow -
  136.  
  137.     @ Form the mixed number list
  138.     numer lcm 3 \->LIST
  139.  
  140.     \>> @ end of scope of lcm numer and carry
  141.  
  142.     @ DISPL the result
  143.     32 DISPL
  144.  
  145. @ Convert the list to elements on the stack
  146. OBJ\-> DROP
  147.  
  148. END 
  149. \>> 'SUBTR' STO
  150.  
  151. \<< 
  152.  
  153. @ Compute LCM of denominators
  154. DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer carry
  155. \<<
  156.  
  157. @ Compute numerator of fraction 1
  158. 2 GETI 3 ROLLD GETI SWAP DROP 
  159. lcm SWAP / 3 ROLL * 'numer' STO
  160.  
  161. @ Compute numerator of fraction 2 and add
  162. SWAP 2 GETI 3 ROLLD GETI SWAP DROP 
  163. lcm SWAP / 3 ROLL * numer + 'numer' STO
  164.  
  165. @ Check for carry and reduce fraction part
  166. numer lcm / IP 'carry' STO
  167. numer lcm MOD 'numer' STO
  168. numer lcm GCD  DUP
  169.  
  170. @ Reduce if non-zero GCD
  171. DUP IF THEN
  172.          numer SWAP / 'numer' STO
  173.          lcm SWAP / 'lcm' STO
  174.        ELSE
  175.      DROP2
  176.        END
  177.  
  178. @ Add the whole numbers and the carry
  179. 1 GET SWAP 1 GET + carry +
  180.  
  181. @ Form the mixed number list
  182. numer lcm 3 \->LIST
  183.  
  184. \>> @ end of scope of lcm numer and carry
  185. \>> 'ADD' STO
  186.  
  187. \<< 
  188.  
  189. @ Convert the elements on the stack to two lists.
  190. 3 \->LIST 4 ROLLD 3 \->LIST SWAP
  191.  
  192. @ Check that both denom's are non-zero.
  193. DUP2 3 GET SWAP 3 GET AND IF NOT 
  194. THEN
  195.    440 .5 BEEP
  196.    "SUBTR: zero in denom" 1 DISP 1 FREEZE
  197. ELSE
  198.  
  199.     64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT
  200.  
  201.     @ Display the first mmultiplier
  202.     SWAP 0 DISPL SWAP 
  203.  
  204.     @ Now figure out where to place the * sign
  205.     1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
  206.     20 R\->B 2 \->LIST PICT SWAP
  207.     " * " 3 \->GROB                         @ GOR the + sign into PICT
  208.     GOR
  209.  
  210.     @ And now the second multiplier
  211.     15 DISPL
  212.     25 R\->B 30 R\->B 2 \->LIST
  213.     85 R\->B 30 R\->B 2 \->LIST LINE
  214.  
  215.     @ Multiply the two mixed numbers and DISPL the sum.
  216.  
  217.     @ Convert the two mixed numbers to improper fractions.
  218.     3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
  219.     SWAP DROP 2 SWAP PUTI DROP
  220.     SWAP
  221.     3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
  222.     SWAP DROP 2 SWAP PUTI DROP
  223.  
  224.     @ Multiply numerators and denominators
  225.     2 GETI 4 ROLLD GET 3 ROLLD
  226.     2 GETI 3 ROLLD GET
  227.     SWAP 4 ROLL * 3 ROLLD * \-> denom numer
  228.     \<<
  229.  
  230.     denom numer GCD
  231.     @ Reduce if non-zero GCD
  232.     DUP IF THEN
  233.          DUP
  234.          numer SWAP / 'numer' STO
  235.          denom SWAP / 'denom' STO
  236.        ELSE
  237.          DROP
  238.        END
  239.  
  240.     @ Convert from an improper fraction to a mixed number
  241.     numer denom / IP
  242.     numer denom MOD
  243.     denom
  244.  
  245.     @ Form the mixed number list
  246.     3 \->LIST
  247.  
  248.     \>> @ end of scope of denom and numer 
  249.  
  250.     @ DISPL the result
  251.     32 DISPL
  252.  
  253. @ Convert the list to three elements on the stack
  254. OBJ\-> DROP
  255.  
  256. END
  257. \>> 'MULTI' STO
  258.  
  259. \<< 
  260.  
  261. @ Convert elements on the stack to two lists.
  262. 3 \->LIST 4 ROLLD 3 \->LIST SWAP
  263.  
  264. @ Check that both denom's are non-zero.
  265. DUP2 3 GET SWAP 3 GET AND IF NOT 
  266. THEN
  267.    440 .5 BEEP
  268.    "DIVI: zero in denom" 1 DISP 1 FREEZE
  269. ELSE
  270.  
  271.     64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT
  272.  
  273.     @ Display the dividend
  274.     SWAP 5 DISPL SWAP 
  275.  
  276.     @ Now figure out where to place the divide sign
  277.     1 GETI SWAP DROP \->STR SIZE 3 + 6 * NEG 65 + R\->B
  278.     25 R\->B 2 \->LIST PICT SWAP
  279.     " / " 3 \->GROB
  280.     GOR
  281.  
  282.     @ And now the divisor
  283.     20 DISPL 
  284.     25 R\->B 35 R\->B 2 \->LIST
  285.     85 R\->B 35 R\->B 2 \->LIST LINE
  286.  
  287.     @ Multiply the two mixed numbers and DISPL the sum.
  288.  
  289.     @ Convert the two mixed numbers to improper fractions.
  290.     3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
  291.     SWAP DROP 2 SWAP PUT
  292.     SWAP
  293.     3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
  294.     SWAP DROP 2 SWAP PUT
  295.     SWAP
  296.  
  297.     @ Invert the quotient
  298.     3 GETI 3 ROLLD DROP 2 GETI PUT SWAP 2 SWAP PUT
  299.  
  300.     @ Multiply numerators and denominators
  301.     2 GETI 4 ROLLD GET 3 ROLLD
  302.     2 GETI 3 ROLLD GET
  303.     4 ROLL * 3 ROLLD * \-> denom numer
  304.     \<<
  305.  
  306.     denom numer GCD
  307.     @ Reduce if non-zero GCD
  308.     DUP IF THEN
  309.          DUP
  310.          numer SWAP / 'numer' STO
  311.          denom SWAP / 'denom' STO
  312.        ELSE
  313.          DROP
  314.        END
  315.  
  316.     @ Convert from an improper fraction to a mixed number
  317.     numer denom / IP
  318.     numer denom MOD
  319.     denom
  320.  
  321.     @ Form the mixed number list
  322.     3 \->LIST
  323.  
  324.     \>> @ end of scope of denom and numer 
  325.  
  326.     @ DISPL the result
  327.     37 DISPL
  328.  
  329. @ Convert the list to elements on the stack
  330. OBJ\-> DROP
  331.  
  332. END
  333. \>> 'DIVI' STO
  334.  
  335. @  Computes the lcm using the 
  336. @  lcm(m,n) * gcd(m,n) = m * n
  337.  
  338. \<< 
  339. DUP2 AND
  340.   IF    @ Check for 0 in the arguments.
  341.   THEN 
  342.      @  Compute m * n then the GCD and finally divide
  343.      DUP2 * 3 ROLLD GCD / 
  344.   ELSE 
  345.      @  Else return a zero
  346.      DROP2 0
  347.   END
  348. \>> 'LCM' STO
  349.  
  350.  
  351. @  This uses Euclid's algorithm to compute the gcd.
  352. @  Euclid's algorithm as Stan remembered it is:
  353. @  If you want the gcd of m and n, then iterate the following:
  354. @  First express  m as q0*n + r0
  355. @  then  express  n as q1*r0 +r1
  356. @  iterate        rn as q(n+2)*r(n+1) + r(n+2)
  357. @  when r(n+2) == 0 then r(n+1) is the gcd.
  358.  
  359. \<< 
  360. DUP2 AND     @ Check for a 0 in the arguments
  361.   IF
  362.   THEN
  363.     @ Apply Euclid's algorithm
  364.     DO DUP 3 ROLLD MOD DUP UNTIL NOT END DROP
  365.   ELSE 
  366.     @ Return a zero if a 0 was in the arguments.
  367.     DROP2 0  
  368.   END
  369. \>> 'GCD' STO
  370.  
  371.  
  372. \<< 
  373.  
  374. 0 DUP \-> row len midp           @ Grab the display row to use
  375.                                  @ and set up a couple locals
  376. \<<
  377.  
  378. @ First handle the whole number
  379. @ Display the whole number only if it is non-zero
  380. @ or the fraction is zero
  381. 1 GETI 3 ROLLD GETI SWAP DROP NOT 3 ROLL OR
  382. IF THEN
  383.   1 GETI \->STR 
  384.   DUP SIZE 'len' STO       @ save the length
  385.   3 \->GROB            @ Get the whole number to a GROB
  386.   PICT SWAP                          @ GOR it into the PICT
  387.   65 len 6 * - R\->B row 4 + R\->B 2 \->LIST 
  388.   SWAP GOR 
  389. ELSE 2 END
  390.  
  391. @ Now for the fraction part.
  392. @ First check the numerator.  If it's zero we're done.
  393. @ Otherwise ...
  394. @ computer the width of the fraction 
  395. GETI DUP IF THEN
  396.    \->STR SIZE 'len' STO
  397.    GETI \->STR SIZE len MAX 4 * 2 / 'midp' STO
  398.    DROP 2
  399.  
  400.    @ Now place the numerator in the PICT
  401.    GETI \->STR
  402.    DUP SIZE 'len' STO        @ Save the length
  403.    1 \->GROB PICT SWAP
  404.    len 2 * NEG midp +
  405.    66 + R\->B row R\->B 2 \->LIST
  406.    SWAP GOR
  407.      
  408.    @ Now the fraction bar
  409.    65 R\->B row 6 + R\->B 2 \->LIST
  410.    65 midp 2 * + R\->B row 6 + R\->B 2 \->LIST LINE
  411.         
  412.    @ Finally the denominator
  413.    GETI \->STR DUP SIZE 'len' STO
  414.    1 \->GROB
  415.    PICT SWAP
  416.    len 2 * NEG midp +
  417.    66 + R\->B row 8 + R\->B 2 \->LIST
  418.    SWAP GOR
  419. ELSE DROP END
  420.      
  421.     @ Display the result
  422.     0 R\->B DUP 2 \->LIST PVIEW 3 FREEZE
  423.     DROP                               @ DROP the GETI index
  424.   
  425. \>>  @ end scope of row and a couple locals
  426.  
  427. \>> 'DISPL' STO
  428.  
  429. @ Displays the 'fraction' on the top of the stack
  430. \<<
  431.   3 \->LIST DUP 3 GET
  432.   IF NOT
  433.      THEN
  434.           440 .5 BEEP "DISP: zero in denom"
  435.           1 DISP 1 FREEZE
  436.      ELSE 
  437.           64 R\->B 131 R\->B BLANK PICT STO
  438.           20 DISPL OBJ\-> DROP
  439.   END
  440. \>> 'DPLAY' STO
  441.  
  442.  
  443. \<< 
  444. 6 ROLL 6 ROLL 6 ROLL
  445. \>> 'SWAPR' STO
  446.  
  447. { S DPLAY 35.2
  448. SWAPR 36.2 DIVI
  449. 65.1 MULTI 75.1
  450. SUBTR 85.1 PLUS
  451. 95.1 } STOKEYS
  452.